home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / mxedit.tk < prev    next >
Text File  |  1992-07-20  |  11KB  |  380 lines

  1. # mxedit.tk --
  2. # This script constructs and editor based on the mxedit widget.
  3. # This script is sourced by the "mxopen" TCL command that creates
  4. # a new window (and new interpreter context) in which to edit a file.
  5. # As such, it is re-read each time you create a new window.
  6. #
  7. # A raw mxedit is just a window that you can edit a file in.
  8. # To be useful, it needs associated scrollbars, menus, command entry
  9. # fields, and a feedback mechanism.  This scripts adds those features.
  10. #
  11. # Copyright (c) 1992 Xerox Corporation.
  12. # Use and copying of this software and preparation of derivative works based
  13. # upon this software are permitted. Any distribution of this software or
  14. # derivative works must comply with all applicable United States export
  15. # control laws. This software is made available AS IS, and Xerox Corporation
  16. # makes no warranty about the software, its performance or its conformity to
  17. # any specification.
  18.  
  19. #
  20. # Exported Globals
  21. # file - the name of the file being edited
  22. # mxedit - the name of the mxedit widget (defined in mxScroll)
  23. # logFeedback - 1 to cause feedback to go to stderr, 0 to stop it
  24.  
  25. # Imported Globals
  26. # mxversion - the version number of the mxedit implementation
  27. # lines - the number of lines in the file
  28.  
  29. # File Globals
  30. # mxFeedbackEntry - the identity of the feedback entry
  31.  
  32. #
  33. # tkerror --
  34. #    This is the handler for background errors that arise
  35. #    from commands bound to keystrokes and menus.  A
  36. #    toplevel message widget is used to display $errorInfo
  37.  
  38. proc tkerror { msg } {
  39.     global errorInfo
  40.     global paleBackground
  41.     global mxedit
  42.  
  43.     if { ! [info exists mxedit] } {
  44.     puts stderr $msg
  45.     return
  46.     }
  47.     if [info exists paleBackground] {
  48.     set background $paleBackground
  49.     } else {
  50.     set background white
  51.     }
  52.     set base ".errorInfo"
  53.     set title "Error Info"
  54.     set savedErrorInfo $errorInfo
  55.     # Create a toplevel to contain the error trace back
  56.     if [catch {
  57.     # Choose a unique name by testing for the associated error variable
  58.     # Use the string ".errorInfo-N" as the name of the toplevel
  59.     # and as the name of a variable holding the current errorInfo
  60.     for {set x 1} {$x<10} {set x [expr $x+1]} {
  61.         global $base-$x
  62.         if {! [info exists $base-$x]} {
  63.         break
  64.         }
  65.     }
  66.     global $base-$x ; set $base-$x $errorInfo
  67.     set title $title-$x
  68.     set name $base-$x
  69.     toplevel $name -background $background
  70.  
  71.     wm title $name $title
  72.     
  73.     buttonFrame $name
  74.     
  75.     packedButton $name.buttons .quit "Dismiss" "destroy $name" left
  76.     message $name.msg -aspect 300 -font fixed     \
  77.         -text $errorInfo -background $paleBackground
  78.     pack append $name $name.msg {top expand}
  79.     } oops] {
  80.     set msg [concat $msg "($name: " $oops ")" ]
  81.    }
  82.  
  83.     if [catch "mxFeedback \{tkerror: $msg\}"] {
  84.     puts stderr "tkrror: $msg"
  85.     puts stderr "*** TCL Trace ***"
  86.     puts stderr $savedErrorInfo
  87.     }
  88. }
  89.  
  90. # mxLibrary --
  91. #    Try to find the TCL library directory that has all the scripts.
  92.  
  93. proc mxLibrary { } {
  94.     global env
  95.     if [file isdirectory [info library]] {
  96.     return [info library]
  97.     } 
  98.     if [info exists env(TCL_LIB)] {
  99.     return $env(TCL_LIB)
  100.     }
  101.     global _lib_warn
  102.     if {! [info exists _lib_warn]} {
  103.     puts stderr "mxLibrary: falling back to \".\""
  104.     set _lib_warn {}
  105.     }
  106.     return "."
  107. }
  108.  
  109. # Suck in a bunch of utility procs
  110. # init.tcl - base stuff for auto_load
  111. # tk.tcl - base stuff for tk
  112. # utils.tk define embellished standard TK widgets
  113. # colors.tk defines sets of complementary colors
  114. # mxedit.utils defines basic editing commands
  115. # mxedit.command defines the command entry
  116. # mxedit.search defines the search/replace entries
  117. # mxedit.bindings defines keystroke bindings and menu acccelerators
  118. # mxedit.menus defines menus
  119. # mxedit.local is for site-specific customizations
  120.  
  121. foreach filename { init.tcl tk.tcl
  122.            utils.tk colors.tk
  123.            mxedit.utils mxedit.command mxedit.search
  124.            mxedit.bindings mxedit.menus } {
  125.     if [catch "source [mxLibrary]/$filename" msg] {
  126.     tkerror "source [mxLibrary]/$filename: $msg"
  127.     }
  128. }
  129. # Turn off auto_exec
  130. global auto_noexec ; set auto_noexec {}
  131.  
  132. # mxinit --
  133. #    This is called from the "mxopen" implementation to initialize the editor
  134. #    This assumes there is a top-level main window called "."
  135. #    This fills out "." for the first file on the command line
  136. #    and then calls mxopen to open a new window on the other files.
  137. #    mxopen creates a new window and calls back to mxinit.
  138. #
  139. proc mxinit { font geometry args } {
  140.     global argv
  141.  
  142.     set self "."
  143.  
  144.     set haveOneWindow 0
  145.     foreach file [lrange $args 0 end] {
  146.     if { ! $haveOneWindow} {
  147.         if [catch {mxsetup $self $file $geometry $font} msg] {
  148.         tkerror "mxsetup \"$file\" failed: $msg"
  149.         } else {
  150.         set haveOneWindow 1
  151.         }
  152.     } else {
  153.         # mxopen is a call back into the application that
  154.         # will ultimately come back here via recursion
  155.         if [catch {mxopen $file -geometry $geometry -font $font} msg] {
  156.         tkerror "mxopen \"$file\" failed: $msg"
  157.         }
  158.     }
  159.     }
  160.     if { ! $haveOneWindow } {
  161.     if [catch {mxsetup $self [mxLibrary]/mxedit.tutorial \
  162.                 $geometry $font} msg] {
  163.         tkerror "mxsetup \"tutorial\" failed: $msg"
  164.     }
  165.     }
  166. }
  167.  
  168. # mxsetup --
  169. #    Populate a frame (or toplevel) with an editor widget, scrollbar, etc
  170. #    parent is the parent widget (a frame or toplevel)
  171. #    filename is what you're editting
  172. #    geometry is something like 80x20
  173. #    font is an X font name
  174. #
  175. proc mxsetup { parent filename {geometry 80x20} {font fixed} } {
  176.     global mxversion
  177.     global lines
  178.     global file
  179.     global mxedit
  180.  
  181. #puts stderr [list mxsetup $filename $geometry $font]
  182.  
  183.     # Command entry
  184.     if [catch {mxCommandEntry $parent 20 {bottom fillx}} msg] {
  185.     tkerror "mxCommandEntry failed: $msg"
  186.     }
  187.  
  188.     # Feedback entry
  189.     if [catch {pack append $parent [mxFeedbackSetup $parent .feedback 20 2] \
  190.                    {bottom fillx}} msg] {
  191.     tkerror "mxFeedbackSetup failed: $msg"
  192.     }
  193.     # Menus
  194.     if [catch {
  195.         pack append $parent [mxMenuSetup $parent] {top fillx}
  196.         mxCreateMenus
  197.     } msg] {    
  198.     tkerror "Menu setup failed: $msg"
  199.     }
  200.  
  201.     # The main editting window coupled with a scrollbar and feedback line
  202.     # It's name will be saved in the mxedit global variable
  203.     pack append $parent \
  204.     [mxScroll $parent $filename mxFeedback $geometry $font] \
  205.     {bottom fillx filly expand}
  206.  
  207.     # Save file name in global variable.  The mxedit implementation
  208.     # does this for us, except it doesn't do scratch files right.
  209.     # The mxopen implementation keeps a count of scratch windows
  210.     # in order to generate unique interpreter names, so we leverage off that.
  211.     if {[llength $filename] == 0} {
  212.     global interpName
  213.     set file [lindex [set interpName] 1]
  214.     mxFeedback "Mxedit $mxversion, $file"
  215.     } else {
  216.     set file $filename
  217.     mxFeedback "Mxedit $mxversion, editing \"$file\": $lines lines"
  218.     }
  219.  
  220.     # Name the window, computing a shortened name for the icon
  221.     mxNameWindow . $file
  222.  
  223.     # Now that all the decorations have been built up,
  224.     # tell the window manager about a gridded window
  225.     # The widthChars (baseWidth) and heightLines (baseHeight)
  226.     # must agree with what was passed to mxedit.  In turn, the mxedit
  227.     # widget tells us about the gridsize based on font metrics
  228.  
  229.     scan $geometry "%dx%d" widthChars heightLines
  230.     if [catch "wm grid . $widthChars $heightLines [$mxedit gridsize]" msg] {
  231.     tkerror "wm grid failed: $msg"
  232.     } else {
  233.     wm geometry . $geometry
  234.     }
  235.  
  236.     # Finally, do per-user and per-site customization
  237.     foreach filename " [mxLibrary]/mxedit.local ~/.mxedit " {
  238.     if [file exists $filename] {
  239.         if [catch "source $filename" msg] {
  240.         puts stderr "source ${filename}: $msg"
  241.         }
  242.     }
  243.     }
  244. }
  245. #
  246. # mxNameWindow --
  247. #    Compute a window name and icon name based on the file name
  248. #    The title is the filename.  The iconname is the last component
  249. #    of the filename.  If the file is dirty, a "!" is appended to both.
  250. #
  251. proc mxNameWindow { window filename } {
  252.     global mxedit
  253.  
  254.     set title $filename
  255.  
  256.     set sindex [string last "/" $filename]
  257.     if {$sindex > 0} {
  258.     set iconname [concat "..." [string range "$filename" $sindex end]]
  259.     } else {
  260.     set iconname "$filename"
  261.     }
  262.     if { ! [catch {set mxedit}] } {
  263.     # mxedit is defined so we can ask it if the file is modified
  264.     if [catch "$mxedit written allWindows"] {
  265.         set title [concat $title " !"]
  266.         set iconname  [concat $iconname " !"]
  267.     }
  268.     }
  269.     wm title $window $title
  270.     wm iconname $window $iconname
  271. }
  272.  
  273. # mxWindowNameFix --
  274. #    Update the window and icon name based on global file variable
  275.  
  276. proc mxWindowNameFix { } {
  277.     global file
  278.     mxNameWindow . $file
  279. }
  280.  
  281. # mxFeedbackSetup --
  282. # Create an entry widget that is used for feedback
  283. # Create a frame to hold messages, and define a procedure to display them.
  284.  
  285. proc mxFeedbackSetup { parent name {width 58} {border 6} } {
  286.     global backgroundColor paleBackground foregroundColor
  287.     global entryFont
  288.     global mxFeedbackEntry mxFeedback
  289.  
  290.     set self [selfName $parent $name]
  291.  
  292.     frame $self -borderwidth 2 -background $backgroundColor -relief raised
  293.  
  294.     # Reverse video the feedback window so it stands apart
  295.     entry $self.entry -width $width -relief flat \
  296.     -font $entryFont \
  297.     -background $backgroundColor -foreground white \
  298.     -selectforeground black -selectbackground $paleBackground
  299.  
  300.     pack append $self $self.entry {left fillx expand}
  301.     pack append $parent $self {left fillx expand}
  302.     bindEntry $self.entry
  303.  
  304.     # Remember the name of the entry widget for later feedback
  305.     set mxFeedbackEntry $self.entry
  306.     # Remember the name of the frame so the command window
  307.     # can be packed and unpacked
  308.     set mxFeedback $self
  309.  
  310.     return $self
  311. }
  312.  
  313. # mxFeedback --
  314. #    Display a message for the user
  315. global logFeedback
  316. if [catch "set logFeedback"] {
  317.     set logFeedback 0
  318. }
  319. global FN ; set FN 0
  320.  
  321. proc mxFeedback { text } {
  322.     global mxFeedbackEntry
  323.     global FN logFeedback
  324.     $mxFeedbackEntry delete 0 end
  325.     $mxFeedbackEntry insert 0 "$text"
  326.     if { $logFeedback } {
  327.     set FN [expr {$FN+1}]
  328.     puts stderr "$FN: $text"
  329.     }
  330.     return "$text"
  331. }
  332.  
  333. # mxScroll --
  334. #    Compose an mxedit and a scrollbar
  335.  
  336. proc mxScroll { parent file feedback geometry font } {
  337.     global mxedit
  338.     global paleBackground
  339.  
  340.     # Frame to hold mxedit and scrollbar
  341.     set self [selfName $parent .mx]
  342.     frame $self -background $paleBackground
  343.  
  344.     # Define a scrollbar and pack it to the left of the mxedit widget
  345.     # (Packing to the right leads to clipping problems when things are resized)
  346.     if [catch { basicScrollbar $self [list $self.edit view]  \
  347.                 {right filly frame e}} msg] {
  348.     tkerror "basicScrollbar failed: $msg"
  349.     }
  350.  
  351.     # Define the main editting window
  352.     mxedit $self.edit -file $file -scroll $self.scroll     \
  353.         -bg white -fg black -selector black \
  354.         -feedback $feedback -geometry $geometry -font $font
  355.     # Remember the name of the mxedit widget so that routines
  356.     # in mxedit.utils can easily access it
  357.     set mxedit $self.edit
  358.     pack append $self $mxedit {right expand fill frame w}
  359.  
  360.     # Set up keystroke bindings.
  361.     if [catch "mxBindings $mxedit" msg] {
  362.     tkerror "mxBindings failed: $msg"
  363.     }
  364.  
  365.     # Turn on history for redo
  366.     if [catch "$mxedit history on" msg] {
  367.     tkerror "$mxedit history on failed: $msg"
  368.     }
  369.  
  370.     return $self
  371. }
  372.  
  373. # mxeditFocus --
  374. #    Move focus to the editing window
  375.  
  376. proc mxeditFocus {} {
  377.     global mxedit
  378.     focus $mxedit
  379. }
  380.